General

Column

Overview



Qual área de pesquisa é emergente?

Qual pesquisador contratar?

Qual patente comprar?



Adicionar uma sentença sobre Shelf Life, para catecterizar a área de pesquisa.



  • Shelf Life
  • 13,516 Registers
  • 12.9% Growth Rate
  • 5.6 Years Doubling Time



  • Scopus
  • 52,000,000 Registers
  • 4.13% Growth Rate
  • 17 Years Doubling Time

Segmented Growth

Groups Growth

Groups Description

Column

Growth

Networks

Groups Attributes

g01

Em construção.

g02

Em construção.

g03

Em construção.

g04

Em construção.

Conclusions

Escrever algum texto para finalizar a análise.

---
title: "A4F - Shelf Life"
output: 
  flexdashboard::flex_dashboard:
    navbar:
      - { title: "Research", href: "http://roneyfraga.com/dash/2020_A4F", align: right }
      - { title: "People", href: "http://roneyfraga.com/dash/2020_A4F/#pessoas", align: right }
      - { title: "Patent", href: "http://roneyfraga.com/dash/2020_A4F/#pessoas", align: right }
      - { title: "About", href: "http://roneyfraga.com/", align: right }
    social: [ "menu" ]
    source_code: "embed"
    theme: bootstrap #yeti #lumen
    logo: img/logo.png
---

```{r setup, include=FALSE}
options(scipen=999)
library(rmarkdown)
library(flexdashboard)
library(pipeR)
library(tidyverse)
library(rio)
library(ggraph)
library(tidygraph)
library(DT)
library(plotly)
library(visNetwork)
library(igraph)
library(ggthemes)
library(highcharter)
library(lubridate)
library(sparkline)
library(htmlwidgets)
library(printr)
```

# General 


Column {data-width=500 .tabset}
-------------------------------------


### Overview



Qual área de pesquisa é emergente?

Qual pesquisador contratar?

Qual patente comprar?



Adicionar uma sentença sobre Shelf Life, para catecterizar a área de pesquisa.



> - __Shelf Life__ > - 13,516 Registers \n > - 12.9% Growth Rate \n > - 5.6 Years Doubling Time \n

> - __Scopus__ > - 52,000,000 Registers \n > - 4.13% Growth Rate \n > - 17 Years Doubling Time \n > ### Segmented Growth ```{r, out.width='75%'} # graphics import('data/shelf_life_growth.txt') %>>% as_tibble %>>% rename(PY = V1, publications = V2 ) %>>% dplyr::filter(PY %in% c(1980:2019)) %>>% dplyr::arrange(PY) %>>% dplyr::mutate(trend=1:n()) %>>% (. -> d) d$lnp <- log(d$publications) PY <- d$PY d$est <- ifelse(PY <= 1986.0, -441.3+(0.2239)*PY, ifelse(PY<=1992.0, -441.3 + (0.2239)*1986.0 + 0.0511*(PY-1986.0), ifelse(PY<=2004.8, -441.3 + (0.2239)*1986.0 + 0.0511*(1992.0-1986.0) + 0.1510*(PY-1992.0), -441.3 + (0.2239)*1986.0 + 0.0511*(1992.0-1986.0) + 0.1510*(2004.8-1992.0) + 0.1186*(PY-2004.8) ))) d %>>% mutate(ln_Publications=lnp, Year=PY) %>>% mutate(ln_Publications=round(ln_Publications,2), est=round(est,2)) %>>% (. -> d2) hchart(d2, "line", hcaes(x = Year, y = ln_Publications), name = "Publications", showInLegend = TRUE, fillOpacity = 0.2) %>>% hc_add_series(d2, "line", hcaes(x = Year, y = est), name = "Segmented Regression", showInLegend = TRUE, fillOpacity = 0.2) %>>% hc_add_theme(hc_theme_elementary()) %>>% hc_navigator( enabled = TRUE) %>>% hc_xAxis( plotBands = list( list( from = 1986, to = 1986, color = "#330000" ), list( from = 1992, to = 1992, color = "#330000" ), list( from = 2004, to = 2004, color = "#330000" ) )) ``` ### Groups Growth ```{r} netcoup <- import('data/netcoup.rds') a <- import('data/netcoup_grupos.rds') netcoup %>>% activate(nodes) %>>% as_tibble %>>% dplyr::filter(!is.na(grupo)) %>>% group_by(PY,grupo) %>>% tally(sort=TRUE) %>>% arrange(grupo,desc(PY)) %>>% ungroup %>>% dplyr::filter(PY %in% c(2000:2019)) %>>% dplyr::mutate(Group=grupo,Publications = n, Year = PY) %>>% (. -> grupoAno) hchart(grupoAno, "line", hcaes(x = Year, y = Publications, group = Group), fillOpacity = 0.2) %>>% hc_add_theme(hc_theme_elementary()) %>>% hc_navigator( enabled = TRUE) ``` ### Groups Description ```{r} data.frame(Group=paste0('g',1:13),Description='algum texto para descrever o grupo') %>>% datatable(options=list(pageLength=13, dom = 'tip'), rownames=F) ``` Column {data-width=500 .tabset} ------------------------------------- ### Growth ```{r} # graphics import('data/shelf_life_growth.txt') %>>% as_tibble %>>% rename(PY = V1, publications = V2 ) %>>% dplyr::filter(PY %in% c(1980:2019)) %>>% dplyr::arrange(PY) %>>% dplyr::mutate(trend=1:n()) %>>% (. -> d) # export(d, '~/OneDrive/Rworkspace/SASUniversityEdition/myfolder/shelf_life/shelf_life.csv') d$lnp <- log(d$publications) # ajustar parametros via mqo m1 <- lm(lnp ~ trend, data=d) # summary(m1) beta0 <- m1$coefficients[[1]] beta1 <- m1$coefficients[[2]] # modelo não linear # 1980 é o primeiro ano da série m2 <- nls(publications ~ b0*exp(b1*(PY-1980)), start = list(b0=beta0, b1=beta1), data=d) # publications estimado d$predicted <- 12.159638*exp(0.121922*(d$PY-1980)) d %>>% mutate(Publications=publications, Year=PY) %>>% mutate(predicted=round(predicted,0)) %>>% (. -> d2) hchart(d2, "column", hcaes(x = Year, y = Publications), name = "Publications", showInLegend = TRUE) %>>% hc_add_series(d2, "line", hcaes(x = Year, y = predicted), name = "Predicted", showInLegend = TRUE) %>>% hc_add_theme(hc_theme_elementary()) %>>% hc_navigator( enabled = TRUE) ``` ### Networks ```{r} netcoup <- import('data/netcoup.rds') hubs <- import('data/netcoup_hubs.rds') hubs %>>% select(SR,Ki) %>>% (. -> hubs2) netcoup %>>% activate(nodes) %>>% left_join(hubs2) %>>% (. -> netcoup) # ALTERAR AQUI ano <- 1990 netcoup %>>% as_tbl_graph() %>>% activate(nodes) %>>% mutate(label=name) %>>% mutate(label=paste( gsub(' .*$','',label), gsub('.*\\.','',label), sep='' )) %>>% dplyr::filter(!is.na(grupo)) %>>% dplyr::filter(PY <= ano) %>>% (. -> netcoup2) tibble(id=1:length(V(netcoup2)), label= V(netcoup2)$label, group=V(netcoup2)$grupo, year=V(netcoup2)$PY ) %>>% (. -> nodes) tibble(from = netcoup2 %>>% activate(edges) %>>% as_tibble %>>% pull(from), to = netcoup2 %>>% activate(edges) %>>% as_tibble %>>% pull(to) ) %>>% (. -> edges) visNetwork(nodes, edges, height = "700px", width = "100%", main = as.character(max(V(netcoup2)$PY))) %>% visNodes(size = 10) %>>% visEdges(width = 2, hidden=F) %>>% visOptions(selectedBy = "group", highlightNearest = TRUE, nodesIdSelection = F) %>>% visPhysics(stabilization = T) %>>% visGroups(groupname = "g01", color = "#38501e") %>>% visGroups(groupname = "g02", color = "#23331e") %>>% visGroups(groupname = "g03", color = "#6e1d21") %>>% visGroups(groupname = "g04", color = "#472926") %>>% visGroups(groupname = "g05", color = "#926433") %>>% visGroups(groupname = "g06", color = "#a90a26") %>>% visGroups(groupname = "g07", color = "#97863e") %>>% visGroups(groupname = "g08", color = "#00FFFF") %>>% visGroups(groupname = "g09", color = "#d48d01") %>>% visGroups(groupname = "g10", color = "#021338") %>>% visGroups(groupname = "g11", color = "#e6d82e") %>>% visGroups(groupname = "g12", color = "#9eb739") %>>% visGroups(groupname = "g13", color = "#808080") ``` ### Groups Attributes ```{r} grupos <- sort(unique(grupoAno$Group)) # grupos <- grupos[1:3] res <- vector('double', length(grupos)) for(i in seq_along(grupos)){ grupoAno %>>% dplyr::select(PY,n,Group) %>>% dplyr::rename(publications = n) %>>% dplyr::filter(PY >= 2000) %>>% dplyr::arrange(PY) %>>% dplyr::filter(Group==grupos[[i]]) %>>% dplyr::mutate(trend=1:n()) %>>% dplyr::mutate(lnp=log(publications)) %>>% (. -> d) # ajustar parametros via mqo m1 <- lm(lnp ~ trend, data=d) beta0 <- m1$coefficients[[1]] beta1 <- m1$coefficients[[2]] # modelo não linear m2 <- nls(publications ~ b0*exp(b1*(PY-2010)), start = list(b0=beta0, b1=beta1), data=d) res[[i]] <- coef(m2)[2] } # print(xtable(grupoAnoCrescimento, type = "latex")) data.frame(Groups=grupos,Coef=res) %>>% as_tibble %>>% mutate(GrowthRateYear=(exp(Coef)-1)*100) %>>% dplyr::select(-Coef) %>>% left_join(import('data/netcoup_grupos.rds') %>>% select(nname,qtde.papers,PY.m) %>>% rename(Groups = nname)) %>>% dplyr::arrange(Groups) %>>% (. -> grupoAnoCrescimento) %>>% dplyr::rename(AverageAge = PY.m) %>>% dplyr::rename(TotalPapers = qtde.papers) %>>% mutate(AverageAge = round(AverageAge,1)) %>>% left_join(import('data/ZiPi.rds') %>>% mutate(Groups=grupo) %>>% select(Groups,Hubs)) %>>% mutate(Description='Adicionar a descrição do grupo. Manter um texto o mais explicativo possível.') %>>% relocate(Description, .after=Groups) %>>% select(-Description) %>>% rename(Group = Groups) %>>% datatable(options=list(pageLength=13, dom = 'tip'), rownames=F) %>>% formatRound('GrowthRateYear',1) ``` # g01 {data-navmenu="Groups"} Em construção. # g02 {data-navmenu="Groups"} Em construção. # g03 {data-navmenu="Groups"} Em construção. # g04 {data-navmenu="Groups"} Em construção. # Conclusions Escrever algum texto para finalizar a análise. # Pessoas {.hidden} Em construção. # Patentes {.hidden} Em construção.